VERSION 5.00
Begin VB.Form LoginForm 
   Appearance      =   0  'Flat
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   9105
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11895
   FillStyle       =   0  'Solid
   ForeColor       =   &H8000000D&
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "LoginForm.frx":0000
   ScaleHeight     =   9105
   ScaleWidth      =   11895
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin VB.PictureBox QuestionMarkPic 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   5655
      Left            =   360
      Picture         =   "LoginForm.frx":0377
      ScaleHeight     =   5655
      ScaleWidth      =   2895
      TabIndex        =   14
      Top             =   2760
      Visible         =   0   'False
      Width           =   2895
   End
   Begin VB.PictureBox LighthousePic 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   4455
      Left            =   480
      Picture         =   "LoginForm.frx":2C17
      ScaleHeight     =   4455
      ScaleWidth      =   2895
      TabIndex        =   13
      Top             =   2940
      Width           =   2895
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Start"
      Height          =   615
      Left            =   720
      TabIndex        =   12
      Top             =   7920
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Exit"
      Height          =   615
      Left            =   1920
      TabIndex        =   10
      Top             =   7920
      Visible         =   0   'False
      Width           =   855
   End
   Begin VCT.TouchKeyPad LoginKeyPad 
      Height          =   3975
      Left            =   7200
      TabIndex        =   8
      Top             =   3840
      Width           =   3495
      _ExtentX        =   6165
      _ExtentY        =   7011
   End
   Begin VB.CommandButton Command11 
      BackColor       =   &H00E0E0E0&
      Caption         =   "Shutdown"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   4080
      TabIndex        =   6
      Top             =   7080
      Width           =   2295
   End
   Begin VB.Timer Timer1 
      Interval        =   800
      Left            =   10440
      Top             =   1680
   End
   Begin VB.CommandButton ResetButton 
      BackColor       =   &H00E0E0E0&
      Caption         =   "Clear"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   732
      Left            =   4080
      TabIndex        =   3
      Top             =   6000
      Width           =   2292
   End
   Begin VB.CommandButton LoginButton 
      BackColor       =   &H00E0E0E0&
      Caption         =   "Start"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   20.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   735
      Left            =   4080
      TabIndex        =   2
      Top             =   4920
      Width           =   2295
   End
   Begin VB.PictureBox MACROPic 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   4455
      Left            =   480
      Picture         =   "LoginForm.frx":44D0
      ScaleHeight     =   4455
      ScaleWidth      =   2895
      TabIndex        =   9
      Top             =   2520
      Width           =   2895
   End
   Begin VB.Label MotoLabel 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "Shedding Light on HIV/AIDS"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   18
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   975
      Left            =   120
      TabIndex        =   11
      Top             =   6960
      Width           =   3255
   End
   Begin VB.Label Version_Label 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3720
      TabIndex        =   7
      Top             =   8520
      Width           =   7695
   End
   Begin VB.Label PwdLabel 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   36
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   4080
      TabIndex        =   5
      Top             =   3480
      Width           =   2295
   End
   Begin VB.Line Line9 
      X1              =   11160
      X2              =   6720
      Y1              =   8160
      Y2              =   8160
   End
   Begin VB.Line Line8 
      X1              =   6720
      X2              =   6720
      Y1              =   3360
      Y2              =   8160
   End
   Begin VB.Line Line7 
      X1              =   11160
      X2              =   11160
      Y1              =   3360
      Y2              =   8160
   End
   Begin VB.Line Line6 
      X1              =   6720
      X2              =   11160
      Y1              =   3360
      Y2              =   3360
   End
   Begin VB.Line Line5 
      BorderWidth     =   2
      X1              =   3720
      X2              =   3720
      Y1              =   2520
      Y2              =   8400
   End
   Begin VB.Line Line4 
      BorderWidth     =   2
      X1              =   11400
      X2              =   3720
      Y1              =   8400
      Y2              =   8400
   End
   Begin VB.Line Line3 
      BorderWidth     =   2
      X1              =   11400
      X2              =   11400
      Y1              =   2520
      Y2              =   8400
   End
   Begin VB.Line Line1 
      BorderWidth     =   2
      X1              =   3720
      X2              =   11400
      Y1              =   2520
      Y2              =   2520
   End
   Begin VB.Label LoginPrompt 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Enter your secret code then press the ""Start"" button"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000002&
      Height          =   375
      Left            =   4320
      TabIndex        =   4
      Top             =   2760
      Width           =   6855
   End
   Begin VB.Label TitleLabel 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "Malawi AIDS Counselling && Resource Organisation"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   27.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   855
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   11655
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "Client Management Information System"
      BeginProperty Font 
         Name            =   "Arial Narrow"
         Size            =   27.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   240
      TabIndex        =   0
      Top             =   1440
      Width           =   11655
   End
End
Attribute VB_Name = "LoginForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim pwd As String
Dim ButtonColor As String
Dim Con As New Connection
Dim Cmd1 As New Command


Private Sub Command1_Click()
   Unload Me
   End
End Sub

Private Sub Command11_Click()
 '  rc = UpdateLog("", "Shut Down", "", Machine_Id)
   success = ExitWindowsEx(EWX_SHUTDOWN, 0)
   Unload Me
   End
End Sub

Private Sub Command2_Click()
   VCTStageForm.Show
   Unload Me
End Sub



Private Sub Form_KeyPress(KeyAscii As Integer)
'This cause the program to end and return the user back to the operating system
   If KeyAscii = 36 Then
      If Pat_Barcode_Str = AppExitCodeConst Then 'the MAGIC NUMBER!
         End
      Else
         If Pat_Barcode_Str = AppSetLocationConst Then  'Show the Set Computer Location screen
            ComputerLocationForm.Show
            Unload Me
         End If
      End If
   Else
      Pat_Barcode_Str = Pat_Barcode_Str & Chr(KeyAscii)
   End If
End Sub

Private Sub Form_Load()

   Dim elen As Long
   Dim TempString As String
   Dim TmpPtr As Printer
   Dim Counter As Integer
   Dim SetTime As SystemTime
   Dim retval As Long

   Command1.Visible = False
   Command2.Visible = False
   Pat_Barcode_Str = ""

   'synchronize the workstation clock with the server
   CnUser.Open ConnectStringForRealData
   Cmd.CommandText = "SELECT HOUR(NOW()), MINUTE(NOW()), SECOND(NOW()), DAYOFMONTH(NOW()), MONTH(NOW()), YEAR(NOW())"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   RsUser.Open Cmd, , adOpenStatic
   SetTime.wHour = RsUser(0)
   SetTime.wMinute = RsUser(1)
   SetTime.wSecond = RsUser(2)
   SetTime.wMilliseconds = 0
   SetTime.wDay = RsUser(3)
   SetTime.wMonth = RsUser(4)
   SetTime.wYear = RsUser(5)
   retval = SetLocalTime(SetTime)
   RsUser.Close
   CnUser.Close
   
   'Create the ComputerLocationTable if it does not exists
   CnUser.Open ConnectStringForRealData
   Cmd.CommandText = "CREATE TABLE IF NOT EXISTS ComputerLocation (" & _
      "WSName VARCHAR(30) NOT NULL, " & _
      "WSLocation VARCHAR(30) NOT NULL," & _
      "PRIMARY KEY (WSName));"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   Cmd.Execute
   CnUser.Close
   
   'establish if there is a printer attached to this workstation
   Counter = 0
   For Each TmpPtr In Printers
      Counter = Counter + 1
   Next TmpPtr
   If Counter > 0 Then
      PrinterAttached = True
   Else
      PrinterAttached = False
   End If
     
   ResetButton.Enabled = False
   
   'Get the computer name for the audit log file
   TempString = String(256, " ")
   elen = GetComputerName(TempString, Len(TempString) - 1)
   Machine_Id = Left(TempString, InStr(TempString, Chr(0)) - 1)
   
   CnUser.Open ConnectStringForRealData
   Cmd.CommandText = "Select WSLocation " _
                      & "From ComputerLocation " _
                      & "Where WSName = '" & Machine_Id & "'"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   RsUser.Open Cmd, , adOpenStatic
   If RsUser.EOF = False Then 'a record was found for that computer
      SiteCodeConst = Mid(RsUser(0), 1, 2) 'Gets the first two digits
   Else
      SiteCodeConst = "Location Not Set"
      LoginButton.Enabled = False
      LoginKeyPad.Enabled = False
   End If
   RsUser.Close
   CnUser.Close
   
   Select Case SiteCodeConst
      Case "01"
         ORGANIZATION = "MACRO"
         Version_Label.Caption = "Version: " & Version_Const & " - Blantyre Site"
         OrganizationString = "Malawi AIDS Counselling && Resource Organisation"
         RegionConst = "01"
         DistrictConst = "29"
         OutreachCodeConst = "00"
         MACROPic.Visible = True
         LighthousePic.Visible = False
         MotoLabel.Visible = True
      Case "02"
         ORGANIZATION = "MACRO"
         Version_Label.Caption = "Version: " & Version_Const & " - Lilongwe Site"
         OrganizationString = "Malawi AIDS Counselling && Resource Organisation"
         RegionConst = "02"
         DistrictConst = "15"
         OutreachCodeConst = "00"
         MACROPic.Visible = True
         LighthousePic.Visible = False
         MotoLabel.Visible = True
      Case "03"
         ORGANIZATION = "MACRO"
         Version_Label.Caption = "Version: " & Version_Const & " - Mzuzu Site"
         OrganizationString = "Malawi AIDS Counselling && Resource Organisation"
         RegionConst = "03"
         DistrictConst = "05"
         OutreachCodeConst = "00"
         MACROPic.Visible = True
         LighthousePic.Visible = False
         MotoLabel.Visible = True
      Case "04"
         ORGANIZATION = "MACRO"
         Version_Label.Caption = "Version: " & Version_Const & " - Zomba Site"
         OrganizationString = "Malawi AIDS Counselling && Resource Organisation"
         RegionConst = "01"
         DistrictConst = "??"
         OutreachCodeConst = "00"
         MACROPic.Visible = True
         LighthousePic.Visible = False
         MotoLabel.Visible = True
      Case "05"
         ORGANIZATION = "MACRO"
         Version_Label.Caption = "Version: " & Version_Const & " - Kasungu Site"
         OrganizationString = "Malawi AIDS Counselling && Resource Organisation"
         RegionConst = "02"
         DistrictConst = "??"
         OutreachCodeConst = "00"
         MACROPic.Visible = True
         LighthousePic.Visible = False
         MotoLabel.Visible = True
      Case "06"
         ORGANIZATION = "MACRO"
         Version_Label.Caption = "Version: " & Version_Const & " - Karonga Site"
         OrganizationString = "Malawi AIDS Counselling && Resource Organisation"
         RegionConst = "03"
         DistrictConst = "??"
         OutreachCodeConst = "00"
         MACROPic.Visible = True
         LighthousePic.Visible = False
         MotoLabel.Visible = True
      Case "11"
         ORGANIZATION = "LIGHTHOUSE"
         Version_Label.Caption = "Version: " & Version_Const & " - Lighthouse Centre"
         OrganizationString = "Lighthouse Voluntary Counseling && Testing"
         RegionConst = "02"
         DistrictConst = "15"
         OutreachCodeConst = "00"
         MACROPic.Visible = False
         LighthousePic.Visible = True
         MotoLabel.Visible = False
      Case "12"
         ORGANIZATION = "LIGHTHOUSE"
         Version_Label.Caption = "Version: " & Version_Const & " - Bottom Hospital"
         OrganizationString = "Lighthouse Voluntary Counseling && Testing"
         RegionConst = "02"
         DistrictConst = "15"
         OutreachCodeConst = "00"
         MACROPic.Visible = False
         LighthousePic.Visible = True
         MotoLabel.Visible = False
      Case "13"
         ORGANIZATION = "LIGHTHOUSE"
         Version_Label.Caption = "Version: " & Version_Const & " - KCH Medical Ward"
         OrganizationString = "Lighthouse Voluntary Counseling && Testing"
         RegionConst = "02"
         DistrictConst = "15"
         OutreachCodeConst = "00"
         MACROPic.Visible = False
         LighthousePic.Visible = True
         MotoLabel.Visible = False
      Case "14"
         ORGANIZATION = "LIGHTHOUSE"
         Version_Label.Caption = "Version: " & Version_Const & " - KCH Paediatric Ward"
         OrganizationString = "Lighthouse Voluntary Counseling && Testing"
         RegionConst = "02"
         DistrictConst = "15"
         OutreachCodeConst = "00"
         MACROPic.Visible = False
         LighthousePic.Visible = True
         MotoLabel.Visible = False
      Case "15"
         ORGANIZATION = "LIGHTHOUSE"
         Version_Label.Caption = "Version: " & Version_Const & " - Area 18 Health Centre"
         OrganizationString = "Lighthouse Voluntary Counseling && Testing"
         RegionConst = "02"
         DistrictConst = "15"
         OutreachCodeConst = "00"
         MACROPic.Visible = False
         LighthousePic.Visible = True
         MotoLabel.Visible = False
      Case "16"
         ORGANIZATION = "LIGHTHOUSE"
         Version_Label.Caption = "Version: " & Version_Const & " - Chinsapo Health Centre"
         OrganizationString = "Lighthouse Voluntary Counseling && Testing"
         RegionConst = "02"
         DistrictConst = "15"
         OutreachCodeConst = "00"
         MACROPic.Visible = False
         LighthousePic.Visible = True
         MotoLabel.Visible = False
      Case Else
         ORGANIZATION = "UNKNOWN"
         Version_Label.Caption = "Version: " & Version_Const & " - Unknown Site"
         OrganizationString = "UNKNOWN ORGANIZATION"
         LoginButton.Enabled = False
         MACROPic.Visible = False
         LighthousePic.Visible = False
         MotoLabel.Visible = False
         QuestionMarkPic.Visible = True
   End Select
   TitleLabel.Caption = OrganizationString
 
   pwd = ""
               
End Sub

Private Sub LoginButton_Click()
   Dim TrainingUserFound As Boolean
  'SQL query to get the record for this user
  
  
  If Len(pwd) <> 6 Then
    pwd = ""
    UpdatePwdLabelText
    PwdErrorForm.Show
  Else
    UserPwd = pwd
    If pwd = "999999" Then
       ConnectString = ConnectStringForTrainingData
       If ORGANIZATION = "MACRO" Then
          CreateMACROClientTable
       Else
          If ORGANIZATION = "LIGHTHOUSE" Then
             CreateLighthouseClientTable
          Else
             MsgBox ("ORGANIZATION Not Defined!")
          End If
       End If
       CreateCounselorTable
       CreateRapidTestTable
       'Check if the 999999 user exists
       CnUser.Open ConnectString
       Cmd.CommandText = "SELECT COUNT(*) FROM counselor"
       Cmd.CommandType = adCmdText
       Cmd.Name = "GetSqlServerDate"
       Cmd.ActiveConnection = CnUser
       RsUser.Open Cmd, , adOpenStatic
       If RsUser(0) = 0 Then
          TrainingUserFound = False
       Else
          TrainingUserFound = True
       End If
       RsUser.Close
       CnUser.Close
        If TrainingUserFound = False Then
         'add the 999999 user
         CnUser.Open ConnectString
         Cmd.CommandText = "INSERT INTO counselor (COUN_CODE, " & _
            "COUN_PWD, COUN_F_NAME, COUN_L_NAME, DATE_LAST_USED) " & _
            "VALUES(" & "'999'" & ",'999999','** Training','Data **','" & StringDate & "');"
         Cmd.CommandType = adCmdText
         Cmd.ActiveConnection = CnUser
         Cmd.Execute
         CnUser.Close
       End If
    Else
       ConnectString = ConnectStringForRealData
       If ORGANIZATION = "MACRO" Then
          CreateMACROClientTable
       Else
          If ORGANIZATION = "LIGHTHOUSE" Then
             CreateLighthouseClientTable
          Else
             MsgBox ("ORGANIZATION Not Defined!")
          End If
       End If
       CreateCounselorTable
       CreateRapidTestTable
    End If
    
   ' CreateCodesTable
    
    If pwd <> "654321" Then
      CnUser.Open ConnectString
      Cmd.CommandText = "Select COUN_F_NAME, COUN_L_NAME" _
                         & " From   counselor" _
                         & " Where  COUN_PWD = '" & pwd & "'"
      Cmd.CommandType = adCmdText
      Cmd.ActiveConnection = CnUser
      'Cmd(0) = pwd
      pwd = ""
      UpdatePwdLabelText
      RsUser.Open Cmd, , adOpenStatic
      
      If RsUser.EOF = False Then 'returned a user
      
         'update the date_last_used field in the counselor table
         Con.Open ConnectString
         Cmd1.CommandText = "UPDATE counselor SET DATE_LAST_USED = '" & StringDate & "' WHERE COUN_PWD = '" & UserPwd & "'"
         Cmd1.CommandType = adCmdText
         Cmd1.ActiveConnection = Con
         Cmd1.Execute
         Con.Close
        
         UserFirst = RTrim(LTrim(RsUser(0)))
         UserLast = RTrim(LTrim(RsUser(1)))
         RsUser.Close
         CnUser.Close
         COUNCODE = ""
         VCTStageForm.Show
         Unload Me
      Else 'no match to the clinician ID
         RsUser.Close
         CnUser.Close
         pwd = ""
         UpdatePwdLabelText
         PwdErrorForm.Show
      End If
                  
    Else '654321 selected so exit to the OS for maintenance
      Unload LoginForm
      'Unload MenuForm
      End
   End If
  End If

  pwd = ""
End Sub

Private Sub LoginKeyPad_NumPressed()
   ResetButton.Enabled = True
   pwd = pwd + LoginKeyPad.KeyNum
   UpdatePwdLabelText
End Sub

Private Sub ResetButton_Click()
   ResetButton.Enabled = False
   pwd = ""
   PwdLabel.Caption = pwd
   LoginButton.SetFocus
End Sub

Private Sub UpdatePwdLabelText()
  Dim SecurePwd As String
  SecurePwd = ""
  For I = 1 To Len(pwd)
    SecurePwd = SecurePwd + "*"
    Next I
  PwdLabel.Caption = SecurePwd
  LoginButton.SetFocus
End Sub

Private Sub Timer1_Timer()
   If LoginPrompt.Caption = "" Then
      LoginPrompt.Caption = "Enter your secret code then press the ""Start"" button"
   Else
      LoginPrompt.Caption = ""
   End If
End Sub


Private Sub CreateRapidTestTable()
   Dim RecordFound As Boolean

   CnUser.Open ConnectString
   Cmd.CommandText = "CREATE TABLE IF NOT EXISTS rapidtest (" & _
      "TEST_NAME VARCHAR(25) NOT NULL, " & _
      "CTRL_DATE CHAR(11)," & _
      "CTRL_TIME CHAR(8)," & _
      "POS_RESULT VARCHAR(12)," & _
      "NEG_RESULT VARCHAR(12)," & _
      "PRIMARY KEY (TEST_NAME));"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   Cmd.Execute
   CnUser.Close
   
   'check for records and add if non
   CnUser.Open ConnectString
   Cmd.CommandText = "SELECT COUNT(*) FROM rapidtest"
   Cmd.ActiveConnection = CnUser
   Cmd.CommandType = adCmdText
   RsUser.Open Cmd, , adOpenStatic
   If RsUser(0) > 0 Then
      RecordFound = True
   Else
      RecordFound = False
   End If
   RsUser.Close
   CnUser.Close
   
   If RecordFound = False Then
      CnUser.Open ConnectString
      Cmd.CommandText = "INSERT INTO rapidtest (TEST_NAME) VALUES ('Hemastrip')"
      Cmd.CommandType = adCmdText
      Cmd.ActiveConnection = CnUser
      Cmd.Execute
      Cmd.CommandText = "INSERT INTO rapidtest (TEST_NAME) VALUES ('Determine')"
      Cmd.Execute
      Cmd.CommandText = "INSERT INTO rapidtest (TEST_NAME) VALUES ('Unigold')"
      Cmd.Execute
      Cmd.CommandText = "INSERT INTO rapidtest (TEST_NAME) VALUES ('Bioline')"
      Cmd.Execute
      Cmd.CommandText = "INSERT INTO rapidtest (TEST_NAME) VALUES ('First Response')"
      Cmd.Execute
      Cmd.CommandText = "INSERT INTO rapidtest (TEST_NAME) VALUES ('Ora-quick')"
      Cmd.Execute
      Cmd.CommandText = "INSERT INTO rapidtest (TEST_NAME) VALUES ('Capillus')"
      Cmd.Execute
      CnUser.Close
   End If
End Sub

Private Sub CreateMACROClientTable()

   CnUser.Open ConnectString
   Cmd.CommandText = "CREATE TABLE IF NOT EXISTS client (VISITID INT(7) NOT NULL, REGION CHAR(2)," & _
      "DISTRICT CHAR(2), SITE CHAR(3), VDATE CHAR(11) NOT NULL, RETURNV CHAR(1), CLNTCODE INTEGER(7) NOT NULL, NEWCODE CHAR(1), SESSTYPE CHAR(2)," & _
      "COUPCODE INTEGER(5), PARTCODE INTEGER(7), COUPTYPE CHAR(2), COUNCODE CHAR(3), SEX CHAR(1), AGE INTEGER(2), RESID CHAR(2), GROUPSES CHAR(1)," & _
      "EMPLOYED CHAR(1), OCCUPAT CHAR(2), EDUEXPE CHAR(2), MARSTAT CHAR(2), MARTYPE CHAR(2), MARHIST CHAR(2), KNOWUS1 CHAR(1), KNOWUS2 CHAR(1)," & _
      "KNOWUS3 CHAR(1), KNOWUS4 CHAR(1), KNOWUS5 CHAR(1), KNOWUS6 CHAR(1), KNOWUS7 CHAR(1), KNOWUS8 CHAR(1), KNOWUS98 CHAR(1), KNOWUS99 CHAR(1)," & _
      "REFERBY CHAR(2), REASHERE CHAR(2), PRTESTED CHAR(2), TMONTH CHAR(2), TYEAR CHAR(4), PRTESITE CHAR(2), EVERHAD CHAR(1), LIFEPART INTEGER(3)," & _
      "SMONTH CHAR(2), SYEAR CHAR(4), EVERAPED CHAR(1), PREG CHAR(2), TRANSFUS CHAR(2), P1TYPE CHAR(2), P1NEW CHAR(1), P1STATUS CHAR(2)," & _
      "P1LTSTMO CHAR(2), P1LTSTYR CHAR(4), P1FPMETH CHAR(2), P1CONUSE CHAR(2), P1CONLST CHAR(2), P2TYPE CHAR(2), P2NEW CHAR(1), P2STATUS CHAR(2), P2LTSTMO CHAR(2), P2LTSTYR CHAR(4)," & _
      "P2FPMETH CHAR(2), P2CONUSE CHAR(2), P2CONLST CHAR(2), P3TYPE CHAR(2), P3NEW CHAR(1), P3STATUS CHAR(2), P3LTSTMO CHAR(2), P3LTSTYR CHAR(4), P3FPMETH CHAR(2)," & _
      "P3CONUSE CHAR(2), P3CONLST CHAR(2), P4TYPE CHAR(2), P4NEW CHAR(1), P4STATUS CHAR(2), P4LTSTMO CHAR(2), P4LTSTYR CHAR(4), P4FPMETH CHAR(2), P4CONUSE CHAR(2)," & _
      "P4CONLST CHAR(2), STISYMPT CHAR(1), TBSYMPT CHAR(1), REFERRED CHAR(1), STID1 CHAR(1), STID2 CHAR(1), STID3 CHAR(1), STID4 CHAR(1)," & _
      "STID5 CHAR(1), STID6 CHAR(1), STID7 CHAR(1), TEST1NAME VARCHAR(20), TEST1RESULT CHAR(1), TEST2NAME VARCHAR(20), TEST2RESULT CHAR(1), TEST3NAME VARCHAR(20), TEST3RESULT CHAR(1), HIV CHAR(2), LABTECH CHAR(6)," & _
      "DISCOR CHAR(2), AFB CHAR(2), OTHERRES CHAR(6), STIT1 CHAR(1)," & _
      "STIT2 CHAR(1), STIT3 CHAR(1), STIT4 CHAR(1), STIT5 CHAR(1), STIT6 CHAR(1), STIT7 CHAR(1), TBTREAT CHAR(1), OTHERTRT CHAR(6)," & _
      "CLINCOND INTEGER(3), RRPLAN0 CHAR(1), RRPLAN1 CHAR(1), RRPLAN2 CHAR(1), RRPLAN3 CHAR(1), RRPLAN4 CHAR(1), RRPLAN5 CHAR(1), RRPLAN6 CHAR(1)," & _
      "RRPLAN7 CHAR(1), RRPLAN8 CHAR(1), RRPLAN9 CHAR(1), RRPLAN10 CHAR(1), RRPLAN11 CHAR(1), RRPLAN99 CHAR(1), REFTO0 CHAR(1), REFTO1 CHAR(1)," & _
      "REFTO2 CHAR(1),  REFTO3 CHAR(1), REFTO4 CHAR(1), REFTO5 CHAR(1), REFTO6 CHAR(1), REFTO7 CHAR(1), REFTO8 CHAR(1),  REFTO98 CHAR(1)," & _
      "REFTO99 CHAR(1), COUNSELD CHAR(1), GAVETEST CHAR(1), GAVERESU CHAR(1), OTHERSRV CHAR(6), COUNCOND INTEGER(3), CLRKCODE CHAR(6)," & _
      "TIMEREG CHAR(8) NOT NULL, TIMEPRE CHAR(8), TIMELAB CHAR(8), TIMEPOST CHAR(8), TIMECLNC CHAR(8), PRINTED CHAR(1), VISITTYP CHAR(1)," & _
      "PRIMARY KEY (VISITID));"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   Cmd.Execute
   CnUser.Close

End Sub


Private Sub CreateLighthouseClientTable()

   CnUser.Open ConnectString
   Cmd.CommandText = "CREATE TABLE IF NOT EXISTS client (VISITID INT(7) NOT NULL, REGION CHAR(2)," & _
      "DISTRICT CHAR(2), SITE CHAR(3), VDATE CHAR(11) NOT NULL, RETURNV CHAR(1), CLNTCODE INTEGER(7) NOT NULL, NEWCODE CHAR(1), SESSTYPE CHAR(2)," & _
      "COUPCODE INTEGER(5), PARTCODE INTEGER(7), COUPTYPE CHAR(2), COUNCODE CHAR(3), SEX CHAR(1), AGE INTEGER(2), RESID CHAR(2), GROUPSES CHAR(1)," & _
      "EMPLOYED CHAR(1), OCCUPAT CHAR(2), EDUEXPE CHAR(2), MARSTAT CHAR(2), MARTYPE CHAR(2), MARHIST CHAR(2), KNOWUS1 CHAR(1), KNOWUS2 CHAR(1)," & _
      "KNOWUS3 CHAR(1), KNOWUS4 CHAR(1), KNOWUS5 CHAR(1), KNOWUS6 CHAR(1), KNOWUS7 CHAR(1), KNOWUS8 CHAR(1), KNOWUS98 CHAR(1), KNOWUS99 CHAR(1)," & _
      "REFERBY CHAR(2), REASHERE CHAR(2), PRTESTED CHAR(2), TMONTH CHAR(2), TYEAR CHAR(4), PRTESITE CHAR(2), EVERHAD CHAR(1), LIFEPART INTEGER(3)," & _
      "SMONTH CHAR(2), SYEAR CHAR(4), EVERAPED CHAR(1), PREG CHAR(2), TRANSFUS CHAR(2), P1TYPE CHAR(2), P1NEW CHAR(1), P1STATUS CHAR(2)," & _
      "P1LTSTMO CHAR(2), P1LTSTYR CHAR(4), P1FPMETH CHAR(2), P1CONUSE CHAR(2), P1CONLST CHAR(2), P2TYPE CHAR(2), P2NEW CHAR(1), P2STATUS CHAR(2), P2LTSTMO CHAR(2), P2LTSTYR CHAR(4)," & _
      "P2FPMETH CHAR(2), P2CONUSE CHAR(2), P2CONLST CHAR(2), P3TYPE CHAR(2), P3NEW CHAR(1), P3STATUS CHAR(2), P3LTSTMO CHAR(2), P3LTSTYR CHAR(4), P3FPMETH CHAR(2)," & _
      "P3CONUSE CHAR(2), P3CONLST CHAR(2), P4TYPE CHAR(2), P4NEW CHAR(1), P4STATUS CHAR(2), P4LTSTMO CHAR(2), P4LTSTYR CHAR(4), P4FPMETH CHAR(2), P4CONUSE CHAR(2)," & _
      "P4CONLST CHAR(2), STISYMPT CHAR(1), TBSYMPT CHAR(1), REFERRED CHAR(1), STID1 CHAR(1), STID2 CHAR(1), STID3 CHAR(1), STID4 CHAR(1)," & _
      "STID5 CHAR(1), STID6 CHAR(1), STID7 CHAR(1), TEST1NAME VARCHAR(20), TEST1RESULT CHAR(1), TEST2NAME VARCHAR(20), TEST2RESULT CHAR(1), TEST3NAME VARCHAR(20), TEST3RESULT CHAR(1), HIV CHAR(2), LABTECH CHAR(6)," & _
      "DISCOR CHAR(2), AFB CHAR(2), OTHERRES CHAR(6), STIT1 CHAR(1)," & _
      "STIT2 CHAR(1), STIT3 CHAR(1), STIT4 CHAR(1), STIT5 CHAR(1), STIT6 CHAR(1), STIT7 CHAR(1), TBTREAT CHAR(1), OTHERTRT CHAR(6)," & _
      "CLINCOND INTEGER(3), RRPLAN0 CHAR(1), RRPLAN1 CHAR(1), RRPLAN2 CHAR(1), RRPLAN3 CHAR(1), RRPLAN4 CHAR(1), RRPLAN5 CHAR(1), RRPLAN6 CHAR(1)," & _
      "RRPLAN7 CHAR(1), RRPLAN8 CHAR(1), RRPLAN9 CHAR(1), RRPLAN10 CHAR(1), RRPLAN11 CHAR(1), RRPLAN12 CHAR(1), RRPLAN99 CHAR(1), REFTO0 CHAR(1), REFTO1 CHAR(1)," & _
      "REFTO2 CHAR(1),  REFTO3 CHAR(1), REFTO4 CHAR(1), REFTO5 CHAR(1), REFTO6 CHAR(1), REFTO7 CHAR(1), REFTO8 CHAR(1),  REFTO9 CHAR(1), REFTO10 CHAR(1), REFTO11 CHAR(1), REFTO98 CHAR(1)," & _
      "REFTO99 CHAR(1), COUNSELD CHAR(1), GAVETEST CHAR(1), GAVERESU CHAR(1), OTHERSRV CHAR(6), COUNCOND INTEGER(3), CLRKCODE CHAR(6)," & _
      "TIMEREG CHAR(8) NOT NULL, TIMEPRE CHAR(8), TIMELAB CHAR(8), TIMEPOST CHAR(8), TIMECLNC CHAR(8), PRINTED CHAR(1), VISITTYP CHAR(1), ADDRESS VARCHAR(50)," & _
      "PRIMARY KEY (VISITID));"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   Cmd.Execute
   CnUser.Close
   
End Sub

'Private Sub CreateCodesTable()
'   Dim RecordFound As Boolean
'
'   'create the codes table if it does not exist
'   CnUser.Open ConnectString
'   Cmd.CommandText = "CREATE TABLE IF NOT EXISTS codes (" & _
'      "CLIENT_CODE INTEGER(7) NOT NULL, " & _
'      "COUPLE_CODE INTEGER(7) NOT NULL)"
'      Cmd.CommandType = adCmdText
'   Cmd.ActiveConnection = CnUser
'   Cmd.Execute
'   CnUser.Close
'
'   'Check if a record exisit in the CODES table
'   CnUser.Open ConnectString
'   Cmd.CommandText = "SELECT COUNT(*) FROM codes"
'   Cmd.ActiveConnection = CnUser
'   Cmd.CommandType = adCmdText
'   RsUser.Open Cmd, , adOpenStatic
'   If RsUser(0) > 0 Then
'      RecordFound = True
'   Else
'      RecordFound = False
'   End If
'   RsUser.Close
'   CnUser.Close
'
'   'Insert a record if non exists and set code global variables to zero
'   If RecordFound = False Then
'      CnUser.Open ConnectString
'      If UserPwd <> "999999" Then
'         Cmd.CommandText = "INSERT INTO codes VALUES (0,0)"
'      Else
'         Cmd.CommandText = "INSERT INTO codes VALUES (2,1)"
'      End If
'      Cmd.ActiveConnection = CnUser
'      Cmd.Execute
'      CnUser.Close
'      NextClientCode = 2
'      NextCoupleCode = 1
'   Else
'      CnUser.Open ConnectString
'      Cmd.CommandText = "SELECT CLIENT_CODE, COUPLE_CODE FROM codes"
'      Cmd.ActiveConnection = CnUser
'      Cmd.CommandType = adCmdText
'      RsUser.Open Cmd, , adOpenStatic
'      NextClientCode = RsUser(0)
'      NextCoupleCode = RsUser(1)
'      RsUser.Close
'      CnUser.Close
'   End If
'End Sub

Private Sub CreateCounselorTable()
   CnUser.Open ConnectString
   Cmd.CommandText = "CREATE TABLE IF NOT EXISTS counselor (" & _
      "COUN_CODE CHAR(3) NOT NULL, " & _
      "COUN_PWD CHAR(6) NOT NULL," & _
      "COUN_F_NAME CHAR(20) NOT NULL," & _
      "COUN_L_NAME CHAR(20) NOT NULL," & _
      "DATE_LAST_USED CHAR(11)," & _
      "PRIMARY KEY (COUN_PWD));"
   Cmd.CommandType = adCmdText
   Cmd.ActiveConnection = CnUser
   Cmd.Execute
   'Cmd.CommandText = "INSERT INTO COUNSELOR VALUES ('T55', '555555', 'VCT', 'Trainee','')"
   'Cmd.Execute
   CnUser.Close
End Sub


